R Notebook

library(pdftools)
library(tidyverse)
library(magrittr)
library(stringi)
library(tidytext)
library(igraph)
library(ggraph)
library(ggplot2)

Loading data

Prepare sets

#for modelling
ocpt2 <- ocpt %>% ungroup()%>% distinct(fullpath, pdf_page, .keep_all = TRUE)

#for text mining
ocpt3 <- ocpt %>% filter(!gcode=="999") %>% ungroup() %>% distinct(fullpath, pdf_page, .keep_all = TRUE)
ocpt3 %<>% mutate(doc_id=paste0(orig_id, ", ", gcode))

Annotating text

library(udpipe)
udmodel <- udpipe_load_model(file = "english-ewt-ud-2.5-191206.udpipe")

up <- udpipe_annotate(udmodel, x = ocpt3$text, doc_id = ocpt3$doc_id)
up <- as.data.frame(up)

Making a list of verbs from available texts

stats <- subset(up, upos %in% c("VERB")) 
stats <- txt_freq(stats$lemma)
stats %>% head(50)
write.csv(stats, "verbs.csv")

Uploading a list of grouped verbs

To find synonims for English words we can use the WordNet and its R wrapper in the wordnet package. (https://bernhardlearns.blogspot.com/2017/04/cleaning-words-with-r-stemming.html)

verbs %<>% str_trim(verb)

Error in match.arg(side) : object 'verb' not found

#verbs_qp <- verbs %>% filter(character=="QN") %>% select(verb)

up2 <- up %>% subset(upos %in% c("VERB"))
up2 %<>% subset(lemma %in% as.vector(verbs$verb))
up2 %<>% merge(txt_freq(up2$lemma), by.x= "lemma", by.y = "key")
# up2 %<>% count(lemma) %>%  mutate(freq = n / sum(n)) %>%   arrange(desc(n))

up2  %<>%  left_join(verbs, by=c("lemma"="verb"))
up2 %<>% unique()
up2 %<>% separate(doc_id, c("doc", "gcode"), sep = ", ")
# verbs %<>% merge(up2, by.x = "verb", by.y="lemma")

up2 %>%
  distinct(lemma, .keep_all = T) %>% 
  group_by(character) %>% arrange(desc(freq)) %>% slice(1:12) %>% ungroup() %>% 
  mutate(verb = reorder_within(lemma, by = freq, within = character)) %>%
  ggplot(aes(x = verb, y = freq, fill = character)) +
    geom_col(show.legend = FALSE) +
    labs(x = "Verbs", y = "frequency") +
    facet_wrap(~character, ncol = 3, scales = "free_y") +
    coord_flip() +
    scale_x_reordered() +
    theme(axis.text.y = element_text(size = 6))

up2 %>% 
  distinct(lemma, .keep_all = T) %>% 
  group_by(character) %>% summarize(sum=sum(freq)) %>% #arrange(desc(sum)) %>% 
  ggplot(aes(x = character, y = sum)) +
    geom_bar(stat = "sum",show.legend = FALSE)

up2 %>% 
  group_by(gcode,character) %>% count(lemma) %>% summarize(sum=sum(n), .groups = "keep") %>%
  mutate(character = reorder_within(character, by = sum, within = gcode)) %>%
  ggplot(aes(x = character, y = sum, fill = gcode)) +
    geom_col(show.legend = FALSE) +
    labs(x = "Verbs", y = "frequency") +
    facet_wrap(~gcode, ncol = 4, scales = "free_y") +
    coord_flip() +
    scale_x_reordered() +
    theme(axis.text.y = element_text(size = 6))

verb_phrase_simp <- "((A|N)*N(P+D*(A|N)*N)*P*(M|V)*V(M|V)*|(M|V)*V(M|V)*D*(A|N)*N(P+D*(A|N)*N)*|(M|V)*V(M|V)*(P+D*(A|N)*N)+|(A|N)*N(P+D*(A|N)*N)*P*((M|V)*V(M|V)*D*(A|N)*N(P+D*(A|N)*N)*|(M|V)*V(M|V)*(P+D*(A|N)*N)+))" # Simple verb Phrase
verb_phrase_with_cc <- "(((A(CA)*|N)*N((P(CP)*)+(D(CD)*)*(A(CA)*|N)*N)*(C(D(CD)*)*(A(CA)*|N)*N((P(CP)*)+(D(CD)*)*(A(CA)*|N)*N)*)*)(P(CP)*)*(M(CM)*|V)*V(M(CM)*|V)*(C(M(CM)*|V)*V(M(CM)*|V)*)*|(M(CM)*|V)*V(M(CM)*|V)*(C(M(CM)*|V)*V(M(CM)*|V)*)*(D(CD)*)*((A(CA)*|N)*N((P(CP)*)+(D(CD)*)*(A(CA)*|N)*N)*(C(D(CD)*)*(A(CA)*|N)*N((P(CP)*)+(D(CD)*)*(A(CA)*|N)*N)*)*)|(M(CM)*|V)*V(M(CM)*|V)*(C(M(CM)*|V)*V(M(CM)*|V)*)*((P(CP)*)+(D(CD)*)*(A(CA)*|N)*N)+|((A(CA)*|N)*N((P(CP)*)+(D(CD)*)*(A(CA)*|N)*N)*(C(D(CD)*)*(A(CA)*|N)*N((P(CP)*)+(D(CD)*)*(A(CA)*|N)*N)*)*)(P(CP)*)*((M(CM)*|V)*V(M(CM)*|V)*(C(M(CM)*|V)*V(M(CM)*|V)*)*(D(CD)*)*((A(CA)*|N)*N((P(CP)*)+(D(CD)*)*(A(CA)*|N)*N)*(C(D(CD)*)*(A(CA)*|N)*N((P(CP)*)+(D(CD)*)*(A(CA)*|N)*N)*)*)|(M(CM)*|V)*V(M(CM)*|V)*(C(M(CM)*|V)*V(M(CM)*|V)*)*((P(CP)*)+(D(CD)*)*(A(CA)*|N)*N)+))" # Verb phrase with coordination conjunction

up3 <- up %>% subset(sentence %in% up2$sentence)
up3 %<>% separate(doc_id, c("doc", "gcode"), sep = ", ")

up3 %<>% mutate(phrase_tag=as_phrasemachine(upos,type="upos"))

verb_phrases <- keywords_phrases(up3$phrase_tag, term = up3$token, 
                                pattern = verb_phrase_simp, is_regex = TRUE, 
                                ngram_max = 7, 
                                detailed = TRUE)

head(sort(table(verb_phrases$keyword), decreasing=TRUE), 20)

             employees are                    we have                     WE GET              WE GET THINGS                   which is         WE GET THINGS DONE 
                        71                         52                         48                         48                         48                         46 
                  that are                    We have Engaging Local Communities                 Manage Our          Manage Our People               We encourage 
                        35                         33                         29                         29                         29                         29 
                 We Manage              We Manage Our       We Manage Our People                      It is                    who are                 enables us 
                        29                         29                         29                         26                         26                         24 
                 which are                      We do 
                        24                         23 

library(textstem)
verb_phrases2 <-verb_phrases

lemmed <- verb_phrases %>% unnest_tokens(word,keyword,token = "ngrams", n=1) 
lemmed %<>% mutate(lemma=lemmatize_words(word, dictionary = lexicon::hash_lemmas))
lemmed_ss <- lemmed %>% subset(lemma %in% verbs$verb[verbs$character=="QP"])
verb_phrases2 %<>% subset(start %in% lemmed_ss$start & end %in% lemmed_ss$end)


verb_phrases2 %>% 
  filter(ngram>=3) %>%
  merge(txt_freq(verb_phrases2$keyword), by.x= "keyword", by.y = "key") %>% 
  arrange(desc(freq)) %>% 
  #group_by(keyword,freq) %>% summari
  distinct(keyword,freq)

# verbs$verb[verbs$character=="QP"]

verb_phrases <- lemmed %>%
  group_by(start, end) %>%
  summarise(string = c(word)) %>%
  rowwise()

  nest_by(ngram, pattern, start, end)

Trying to find cooccurrences amoung slected verbs and nouns — some uncertainty introduced since lemma can be both noun and a verb.

cooc <- cooccurrence(x = subset(up3, upos %in% c("NOUN", "VERB")), 
                     term = "lemma", 
                     group = c("doc", "gcode", "paragraph_id", "sentence_id"))
cooc %<>% subset(term1 %in% verbs$verb | term2 %in% verbs$verb) 
cooc %>% str()

Classes ‘cooccurrence’, ‘data.table’ and 'data.frame':  34150 obs. of  3 variables:
 $ term1: chr  "employee" "do" "employee" "provide" ...
 $ term2: chr  "provide" "management" "offer" "training" ...
 $ cooc : num  254 143 143 141 135 122 120 114 108 101 ...

wordnetwork <- head(cooc, 50)
wordnetwork <- graph_from_data_frame(wordnetwork)
ggraph(wordnetwork, layout = "fr") +
  geom_edge_link(aes(width = cooc, edge_alpha = cooc), edge_colour = "lightblue") +
  geom_node_text(aes(label = name), col = "blue", size = 4) +
  theme_graph(base_family = "Sans Serif") +
  theme(legend.position = "none") +
  labs(title = "Cooccurrences within sentence", subtitle = "Nouns & Verbs")

Merging done badly

tempds<-up2 %>% select(doc, gcode, paragraph_id, sentence_id, freq, freq_pct, lemma, character) 

tempds <- left_join(up3, tempds, by=c("doc", "gcode", "paragraph_id", "sentence_id"))

tempds %<>% distinct(doc, gcode, paragraph_id, sentence_id, token_id, .keep_all = T)

Top 5 verbs in every verb group

Most cooccured nouns with verbs by character in 403 code

freq <- tempds %>%
  filter(gcode=="403") %>% 
  subset(lemma.y %in% t5v$lemma & upos %in% "NOUN") %>%
  group_by(lemma.y) %>% count(lemma.x) %>% mutate(freq = n / sum(n)) %>% ungroup()
freq

freq %>% 
  merge(t5v %>% select(lemma,character), by.x="lemma.y", by.y="lemma") %>% 
  #group_by(character) %>% count()
  group_by(lemma.y) %>% arrange(desc(n)) %>% slice(1:5) %>% ungroup() %>% 
  mutate(lemma.y = str_c("(",character,") ",lemma.y, sep=""),
         noun = reorder_within(lemma.x, by = n, within = lemma.y)) %>%
  ggplot(aes(x = noun, y = n, fill = character)) +
    geom_col(show.legend = FALSE) +
    labs(x = "Nouns", y = "frequency") +
    facet_wrap(~lemma.y, ncol = 4, scales = "free_y") +
    coord_flip() +
    scale_x_reordered() +
    #facet_grid(~character)+
    theme(axis.text.y = element_text(size = 6))

Top Nouns cooccured with verbs by every verb-character

 
tempds %>%
  subset(lemma.y %in% t5v$lemma & upos %in% "NOUN") %>%
  group_by(gcode,character) %>% count(lemma.x) %>% mutate(freq = n / sum(n)) %>% ungroup() %>% 
  filter(gcode=="401") %>% 
  group_by(character) %>% arrange(desc(n)) %>% slice(1:12) %>% ungroup() %>%
  #mutate(noun = reorder_within(lemma.x, by = n, within = character),) %>%
  ggplot(aes(x = lemma.x, y = n, fill = character)) +
    geom_col(show.legend = FALSE) +
    labs(x = "Nouns", y = "frequency") +
    #facet_wrap(~character, ncol = 6, scales = "free_y") +
    coord_flip() +
    #scale_x_reordered() +
    facet_grid(~character)+
    theme(axis.text.y = element_text(size = 6))

Trying more semantic analysis

Selecting words that are related to the verbs and leaving only nsubj, obl, advcl, ccomp

up5 <- up3 %>%
  group_by(doc, gcode, paragraph_id, sentence_id) %>%
  group_modify(~mutate(.x,
                       root_tok_id=subset(.,dep_rel=="root") %>% .$token_id,
                       verb=subset(.,dep_rel=="root") %>% .$lemma)) %>% 
  ungroup() %>%
  subset(head_token_id==root_tok_id|head_token_id==0)

up5 %<>% subset(!dep_rel=="punct")
up5 %<>% subset(!lemma=="be")
up5 %<>% merge(verbs, by.x="verb", by.y="verb") %>% distinct(doc, gcode, paragraph_id, sentence_id, token_id, .keep_all = T) #merging question

change doc to integer, get rid of duplicates, plot top gri with verbs and top words as i did in most cooccured nouns.

Example with nsubj, etc. Meaning that the link is the following: “something — does”, “obl”, “obj”, “nsubj:pass”, “aux:pass”, “advcl”, “ccomp”

my_code <- 413
my_code_name <- "Local Communities"
## Sub-setting the list of dependable words to nsubj, obl, obj, nsubj:pass, aux:pass, advcl, ccomp
freq <- up5 %>%
  filter(gcode==my_code) %>% 
  filter(dep_rel %in% c("nsubj", "obl", "obj", "nsubj:pass", "aux:pass", "advcl", "ccomp")) %>%
  mutate(lemma=str_c(lemma, " (",dep_rel,")", sep = "")) %>% 
  group_by(verb,character) %>% count(lemma) %>% mutate(freq = n / sum(n)) %>% ungroup() #%>% 
  #merge(up5, by=c("verb","lemma")) %>% distinct(doc, gcode, paragraph_id, sentence_id, token_id, .keep_all = T)

## Making the list of five top verbs in every category
t5vup5 <- up5 %>% 
  group_by(character) %>% 
  count(verb) %>% 
  arrange(desc(n)) %>% 
  slice(1:5) %>% 
  ungroup()
t5vup5

freq %>% 
  subset(verb %in% t5vup5$verb) %>% # taking only 5 top verbs in every category
  group_by(verb) %>% arrange(desc(n)) %>% slice(1:10) %>% ungroup() %>% # taking up to 10 words for every verb
  #group_by(character) %>% arrange(desc(n)) %>% slice(1:10) %>% ungroup() %>%
  #group_by(verb) %>% count() %>% arrange(desc(n))
  mutate(verb = str_c("(",character,") ",verb, sep=""), # adding category to verb
         lemma = reorder_within(lemma, by = n, within = verb)) %>% # reordering words in every group
  ggplot(aes(x = lemma, y = n, fill = character)) +
    geom_col(show.legend = T) +
    labs(x = "nsubj, obl, obj, nsubj:pass, aux:pass, advcl, ccomp", 
         y = "Number of occurrences",
         title = str_c("Effects reflected in GRI Reports under ", my_code, " code: ", my_code_name, sep = "")) +
    facet_wrap(~verb, ncol = 5, scales = "free_y") +
    coord_flip() +
    scale_x_reordered() +
    #facet_grid(~character)+
    theme(axis.text.y = element_text(size = 6), 
          legend.position = "bottom",
          legend.direction = "horizontal")+
    scale_fill_discrete(labels=c("Quality negative", "Quality neutral", "Quality positive", "Other", "Quantity negative", "Quantity positive"),
                        name="Impact verb category")

Example with gcodes

freq %>% 
  group_by(character) %>% arrange(desc(n)) %>% slice(1:12) %>% ungroup() %>%
  #mutate(noun = reorder_within(lemma.x, by = n, within = character),) %>%
  ggplot(aes(x = lemma, y = n, fill = character)) +
    geom_col(show.legend = FALSE) +
    labs(x = "Nouns", y = "frequency") +
    #facet_wrap(~character, ncol = 6, scales = "free_y") +
    coord_flip() +
    #scale_x_reordered() +
    facet_grid(~character)+
    theme(axis.text.y = element_text(size = 6))

t5vup5 <- freq %>% select(verb,lemma,character,n,freq) %>% distinct() %>% group_by(character) %>% arrange(desc(freq)) %>% slice(1:5) %>% ungroup() t5vup5

undata2 <- pre_pro_rep %>% 
  unnest_tokens(bigram,text,token = "ngrams", n=2) #%>% 
  #mutate(bigram = bigram %>% str_remove_all("[^[:alnum:]]")) %>% 

undata1 <- pre_pro_rep %>% 
  unnest_tokens(word,text,token = "ngrams", n=1) %>% 
  mutate(word = word %>% str_remove_all("[^[:alnum:]]")) %>% 
  mutate(word = word %>% str_remove_all(rem_dig)) %>% 
  mutate(word = word %>% str_remove_all("null")) %>% 
  filter(!is.na(word)) %>% 
  anti_join(stop_words, by = "word")

bigrams_separated <- undata2 %>% separate(bigram, c("word1", "word2"), sep = " ")
bigrams_filtered <- bigrams_separated %>% filter(!word1 %in% stop_words$word) %>% filter(!word2 %in% stop_words$word)

# new bigram counts:
bigram_counts <- bigrams_filtered %>% count(word1, word2, sort = TRUE)
bigrams_united <- bigrams_filtered %>% unite(bigram, word1, word2, sep = " ")
bigrams_united %<>% add_count(X,bigram) %>% bind_tf_idf(term = bigram, document = X, n = n)

words <- undata1 %>% add_count(X,word) %>% bind_tf_idf(term = word, document = X, n = n)

bigrams_united %>% count(bigram, wt = tf_idf, sort = TRUE) %>% head(25)

top_by_g <- bigrams_united %>% group_by(gcode) %>% count(bigram, wt = tf_idf, sort = TRUE, name = "tf_idf") %>% dplyr::slice(1:12) %>% ungroup()

top_by_g <- words %>% group_by(gcode) %>% count(word, wt = tf_idf, sort = TRUE, name = "tf_idf") %>% dplyr::slice(1:5) %>% ungroup()

top_by_y <- bigrams_united %>% group_by(rep_year) %>% count(bigram, wt = tf_idf, sort = TRUE, name = "tf_idf") %>% dplyr::slice(1:12) %>% ungroup()

# top bigrams in each g_code
top_by_g %>% mutate(bigram = reorder_within(bigram, by = tf_idf, within = gcode)) %>%
  ggplot(aes(x = bigram, y = tf_idf, fill = gcode)) +
    geom_col(show.legend = FALSE) +
    labs(x = NULL, y = "tf-idf") +
    facet_wrap(~gcode, ncol = 3, scales = "free") +
    coord_flip() +
    scale_x_reordered() +
    theme(axis.text.y = element_text(size = 6))


top_by_g %>% mutate(word = reorder_within(word, by = tf_idf, within = gcode)) %>%
  ggplot(aes(x = word, y = tf_idf, fill = gcode)) +
    geom_col(show.legend = FALSE) +
    labs(x = NULL, y = "tf-idf") +
    facet_wrap(~gcode, ncol = 3, scales = "free") +
    coord_flip() +
    scale_x_reordered() +
    theme(axis.text.y = element_text(size = 8))

library(textdata)
library(recipes)
library(tidymodels)
library(textrecipes)
library(themis)
library(tune)
library(glmnet)
library(ranger)

mdata <- ocpt2 %>% ungroup() %>%  select(gcode,text)

ocpt2 %>% ungroup() %>%  select(gcode,text) %>% count(gcode)

#glove6b <- embedding_glove6b(dimensions = 100)

set.seed(1234)

rem_punct <- regex("[[:punct:]]")
rem_dig <- regex("[[:digit:]]")

mdata %<>% mutate(text=str_squish(text),
                  text=str_remove_all(text,rem_punct),
                  text=str_remove_all(text,rem_dig))

mdata %>% group_by(gcode) %>% count(sort = T)# %>% slice(1:8) %>% ungroup() # %>% ggplot(aes(x = gcode, y = n)) + geom_col()

mdata %<>% filter(gcode %in% c("401","403","404", "407", "405","413","414","417","416","999"))
# mdata %<>% filter(!gcode %in% c("409","410","411"))
# mdata %<>% drop_na()
mdata %<>% mutate(gcode=as.factor(gcode))

#downsampling

mdata %>% filter(gcode %in% c("999"))

no_label_index <- which(mdata$gcode==999)
# labeled_index <- which(!mdata$gcode==999)
random_indexes <- sample(1:length(no_label_index), length(no_label_index)-300, replace=F)
# random_downsample <- no_label_index[-c(random_indexes)]

mdata <-mdata[-c(no_label_index[c(random_indexes)]),]

mdata %>% count(gcode)

write.csv(mdata, "mdata_2.csv")

tidy_split <- initial_split(mdata, strata = gcode, prop = 0.7)
train_data <- training(tidy_split)
test_data <- testing(tidy_split)
tidy_split

<Analysis/Assess/Total>
<1277/552/1829>

train_data <- recipe(gcode~., data = train_data) %>% themis::step_upsample(gcode) %>% prep() %>% juice()


train_data %<>% mutate(text=as.character(text))

data_res <- train_data %>% vfold_cv(strata = gcode, v = 10, repeats = 3)
data_res <- vfold_cv(train_data)

tf_idf_rec <- recipe(gcode ~ ., data = train_data) %>%
  step_tokenize(text) %>%
  step_stem(text) %>%
  step_stopwords(text) %>%
  step_tokenfilter(text, max_tokens = 1000) %>%
  step_tfidf(all_predictors())

tf_idf_data <- tf_idf_rec %>% prep() %>% juice()

hash_rec <- recipe(gcode~., data = train_data) %>%
  step_tokenize(text) %>%
  step_stem(text) %>%
  step_stopwords(text) %>%
  step_tokenfilter(text, max_tokens = 1000) %>%
  step_texthash(text, num_terms = 100)

hash_rec %>% prep() %>% juice()

NA

model_lg <- multinom_reg() %>%
  set_args(penalty=tune(), mixture=NULL) %>% 
  set_engine("glmnet") %>%
  set_mode("classification")

model_rf <- rand_forest() %>%
  set_engine("ranger", importance = "impurity") %>%
  set_mode("classification")

logistic_grid <- grid_regular(parameters(model_lg), levels = 3)
model_control <- control_grid(save_pred = TRUE)
model_metrics <- metric_set(accuracy, roc_auc)

linear_tf_res <- tune_grid(model_lg, tf_idf_rec, grid = logistic_grid, control = model_control, metrics = model_metrics, resamples = data_res)
linear_hash_res <- tune_grid(model_lg, hash_rec, grid = logistic_grid, control = model_control, metrics = model_metrics, resamples = data_res)

workflow_general_tf <- workflow() %>% add_recipe(tf_idf_rec)
workflow_lg_tf <- workflow_general_tf %>% add_model(model_lg)
workflow_rf_tf <- workflow_general_tf %>% add_model(model_rf)

workflow_general_hash <- workflow() %>% add_recipe(hash_rec)
workflow_lg_hash <- workflow_general_hash %>% add_model(model_lg)
workflow_rf_hash <- workflow_general_hash %>% add_model(model_rf)

linear_tf_res %>% autoplot()

best_param_linear_tf_res <- linear_tf_res %>% select_best(metric = 'accuracy')
best_param_linear_tf_res

workflow_final_lg_tf <- workflow_lg_tf %>%
  finalize_workflow(parameters = best_param_linear_tf_res)

log_res_tf <- workflow_final_lg_tf %>%
  fit_resamples(resamples = data_res,
                metrics = metric_set(recall, precision, f_meas, accuracy, kap, roc_auc, sens), control = control_resamples(save_pred = TRUE))

log_res_tf %>% collect_metrics(summarize = TRUE)

linear_hash_res %>% autoplot()

best_param_linear_hash_res <- linear_hash_res %>% select_best(metric = 'accuracy')
best_param_linear_hash_res

workflow_final_lg_hash <- workflow_lg_hash %>%
  finalize_workflow(parameters = best_param_linear_hash_res)

log_res_hash <- workflow_final_lg_hash %>%
  fit_resamples( resamples = data_res,
                 metrics = metric_set(recall, precision, f_meas, accuracy, kap, roc_auc, sens), control = control_resamples(save_pred = TRUE))

log_res_hash %>% collect_metrics(summarize = TRUE)

rf_res_hash <- workflow_rf_hash %>%
  fit_resamples(resamples = data_res,
                metrics = metric_set(recall, precision, f_meas, accuracy, kap, roc_auc, sens),
                control = control_resamples( save_pred = TRUE))

rf_res_hash %>% collect_metrics(summarize = TRUE)

NA

rf_res_tf <- workflow_rf_tf %>%
  fit_resamples(resamples = data_res,
                metrics = metric_set(recall, precision, f_meas, accuracy, kap, roc_auc, sens),
                control = control_resamples( save_pred = TRUE))
rf_res_tf %>% collect_metrics(summarize = TRUE)

NA

log_metrics_tf <- log_res_tf %>% collect_metrics(summarise = TRUE) %>% mutate(model = "Logistic Regression TF-idf")
log_metrics_hash <- log_res_hash %>% collect_metrics(summarise = TRUE) %>% mutate(model = "Logistic Regression Hash")
rf_metrics_tf <- rf_res_tf %>% collect_metrics(summarise = TRUE) %>% mutate(model = "Random Forest TF-idf")
rf_metrics_hash <- rf_res_hash %>% collect_metrics(summarise = TRUE) %>% mutate(model = "Random Forest Hash")


model_compare <- bind_rows(
  log_metrics_tf, 
  log_metrics_hash, 
  rf_metrics_tf, 
  rf_metrics_hash)



rf_stat1 <- rf_res_tf %>% collect_metrics(summarize = TRUE)
rf_stat1

model_comp <- model_compare %>%
  select(model, .metric, mean, std_err) %>%
  pivot_wider(names_from = .metric, values_from = c(mean, std_err))


model_comp %>%
  arrange(mean_f_meas) %>%
    mutate(model = fct_reorder(model, mean_f_meas)) %>%
      ggplot(aes(model, mean_f_meas, fill=model)) +
      geom_col() + coord_flip() +
      scale_fill_brewer(palette = "YlGn") +
      geom_text(size = 3, aes(label = round(mean_f_meas, 2), y = mean_f_meas + 0.08), vjust = 1)

rf_pred_tf <- rf_res_tf %>%
  collect_predictions()

rf_pred_tf %>% conf_mat(gcode, .pred_class)

          Truth
Prediction 401 403 404 405 407 413 414 416 417 999
       401 171   8   8   7   0   0   0   0   0   7
       403  18 203   3   3   0   3   1   2   0   3
       404  19   3 216   2   0   0   2   0   0   2
       405  10   4   2 213   0   0   0   0   0   5
       407   1   4   0   1 233   0   1   0   0   1
       413   6   0   1   0   0 221   0   0   0  10
       414   2   1   2   1   0   0 228   1   0   5
       416   1   1   0   0   0   2   0 228   1   1
       417   1   0   0   0   0   0   0   0 230   3
       999   4   9   1   6   0   7   1   2   2 196

rf_pred_tf %>% conf_mat(gcode, .pred_class) %>% autoplot(type = "heatmap")

last_fit_rf <- last_fit(workflow_rf_tf,
                        split = tidy_split,
                        metrics = metric_set(recall, precision, f_meas, accuracy, kap, roc_auc, sens))

rf_stat2 <- last_fit_rf %>% collect_metrics()
rf_stat2

last_fit_rf %>% collect_predictions() %>% conf_mat(gcode, .pred_class) %>% autoplot(type = "heatmap")

myt <- rf_stat1 %>% left_join(rf_stat2, by=".metric") %>% select(.metric, mean, std_err, .estimate)
myt

NA

library(stargazer)
library(xtable)
#stargazer(myt, type = "latex", out = "models.tex")
stargazer(myt, type = "text")
print(xtable(myt, type = "latex"), file = "myt.tex")

nyt <- ocpt2 %>% group_by(gcode) %>% count()

library(parsnip)
library(recipes)
library(workflows)
library(modeldata)

prod_ds <- read.csv("listed_danish_companies_text_pure.csv") %>% select(-X)

tf_idf_rec_production <- recipe(gcode ~ ., data = prod_ds) %>%
  step_tokenize(text) %>%
  step_stem(text) %>%
  step_stopwords(text) %>%
  step_tokenfilter(text, max_tokens = 1000) %>%
  step_tfidf(all_predictors())

tf_idf_prod <- tf_idf_rec_production %>% prep() %>% juice()

model_rf <- rand_forest() %>%
  set_engine("ranger", importance = "impurity", num.threads = parallel::detectCores()) %>%
  set_mode("classification")

wf_rf_tf <- workflow() %>%
            add_recipe(tf_idf_rec) %>%
            add_model(model_rf)